GS <- mutate(GS,Date = as.Date(Date, format = "%d-%b-%y"))
GSxts <- tk_xts(GS)
## Warning in tk_xts_.data.frame(data = data, select = select, date_var =
## date_var, : Non-numeric columns being dropped: Date
## Using column `Date` for date_var.
allDates = index(GSxts)
firstDate <- min(allDates)
lastDate <- max(allDates)-30 #find the last start_date
while(!lastDate %in% allDates)
  lastDate <- lastDate-1

result <- data.frame(`StartDate` = as.Date(character()), `OptionPnL` = double(), `HedgingPnL` = double(), `FinalPnL` = double(), `MaxDrawdown` = double(), `SharpeRatio` = double(), `StartPrice`= double(), `EndPrice` = double(), `AvgPrice` = double(), `AvgGrowthRate` = double())
startD <- firstDate
for(startD in firstDate:lastDate){
  startD <- as.Date(startD)
  if(startD %in% allDates){
    endD <- startD+30
    #adjust the end date backwards if end date (a calendar day) is not in the xts
    while(!endD %in% allDates)
      endD <- endD-1
    
    xts_obj <- GSxts[paste(c(startD,endD),collapse = "/")]
    
    quantity = 100
    dates <- index(xts_obj)
    start_date <- min(dates)
    end_date <- max(dates)
    start_price <- as.numeric(xts_obj[start_date, "Close"])
    start_volatility <- as.numeric(xts_obj[start_date, "IV30"])
    
    df <- tibble(Date = dates)
    df$Close <- coredata(xts_obj[, "Close"])
    df$IV30 <- coredata(xts_obj[, "IV30"])
    avgChange <- as.numeric(mean(xts_obj[, "Change"],na.rm=TRUE))
    #X <- start_price
    #sigma = start_volatility
    r <- 0.8 / 100
    # Vary S and Time everyday
    #S <- df$Close
    #Time <- (end_date - df$Date) / 365
    
    #GBSOption(TypeFlag, S, X, Time, r, b, sigma)@price
    
    df_opt <- rowwise(df) %>%
    #this is the premium for one unit of call option  
    mutate(premium = GBSOption(TypeFlag = "c",
    S = Close,
    X = as.numeric(start_price),
    Time = as.numeric((end_date - Date) / 365),
    r = r, # interest rate
    b = 1.85/100, # dividend yield obtained from https://www.dividend.com/dividend-stocks/financial/investment-brokerage-national/gs-goldman-sachs/
    sigma = as.numeric(start_volatility/100))@price,
    
    #this is the delta of a call option (before negation)
    delta_hedge = GBSGreeks("delta", TypeFlag = "c", 
                            S = Close, 
                            X = as.numeric(start_price), 
                            Time = as.numeric((end_date - Date) / 365), 
                            r = r, 
                            b = 1.85/100, 
                            sigma = as.numeric(start_volatility/100))) %>%
    ungroup() %>%
      
    #delta hedging strategy selected: SHORT CALL LONG STOCK (from BlackS Scholes formula, such strategy should approximate a long position in risk free)
    mutate(Option_DoD_PnL = ifelse(Date == start_date, # On the 1st date, we count the cost of buying the option
    0, #quantity*premium, #on the first day, receive the call option premium and short the option
    -quantity*(premium - Lag(premium))), #if subsequently call option price rises, there is a loss
    
    Hedging_DoD_Pnl = ifelse(Date == start_date, 0, 
                             ifelse(Date == end_date, yes = quantity * Lag(delta_hedge) * (Close - Lag(Close)), 
                                    #at the last day, there is no rebalancing of number of shares.
                                    no = quantity * delta_hedge * (Close - Lag(Close)))), #long stock - if stock price increase, there is a profit
    
    DoD_PnL = Option_DoD_PnL + Hedging_DoD_Pnl) %>%
    mutate(PnL_to_date = cumsum(DoD_PnL),
           HPnL_to_date = cumsum(Hedging_DoD_Pnl), 
           OPnL_to_date = cumsum(Option_DoD_PnL))
    
    maxDrawDown <- {
    xs <- df_opt$PnL_to_date
    max(cummax(xs) - cummin(xs))
    }
    
    #The initial outflow of funds is the cost to buy stocks minus option premium received 
    #InitialInvt = (df_opt[[1,"delta_hedge"]]*df_opt[[1,"Close"]] - df_opt[[1,"premium"]])*quantity #OUTFLOW of funds
    #profitability = df_opt[df_opt$Date==end_date,"PnL_to_date"]/InitialInvt
    #df_opt<-mutate(df_opt, PortValue = InitialInvt + PnL_to_date, PortReturn = DoD_PnL/Lag(PortValue))
    
    #ggplotly(p=ggplot(df_opt) + geom_line(aes(TTM,Option_DoD_PnL),color = "blue") + ggtitle("option profit - TTM"))
    #ggplotly(p=ggplot(df_opt) + geom_line(aes(TTM,Hedging_DoD_Pnl))+ggtitle("stock profit - TTM"))
    
    #renderTable(tail(df_opt,1))
    
    
    #renderText(paste0("the Sharpe Ratio is ",round(SR,4)))
    #renderText(paste0("The maximum drawdown is ", round(maxDrawDown,4)))
    hedgingPnl <- as.numeric(df_opt[df_opt$Date==end_date,"HPnL_to_date"])
    finalPnl <- as.numeric(df_opt[df_opt$Date==end_date,"PnL_to_date"])
    optionPnl <- as.numeric(df_opt[df_opt$Date==end_date,"OPnL_to_date"])
    endPrice <- as.numeric(df_opt[df_opt$Date==end_date,"Close"])
    avgPrice <- as.numeric(mean(df_opt$Close,na.rm=TRUE))
    SR <- as.numeric((finalPnl/30)/stdev(df_opt$DoD_PnL, na.rm = TRUE)) #r is omitted
    result <- rbind(result,data.frame("StartDate" = start_date, "OptionPnL" = optionPnl, "HedgingPnL" = hedgingPnl, "FinalPnL" = finalPnl, "MaxDrawdown" = maxDrawDown, "SharpeRatio" = SR,"StartPrice"=start_price , "EndPrice" = endPrice, "AvgPrice" = avgPrice, "AvgGrowthRate" = avgChange))
    
  }}
    ggplotly(p = ggplot(GS) + geom_line(aes(Date, Close))) #stock close price
    ggplotly(p = ggplot(GS) + geom_density(aes(Close))) #density of close price
    ggplotly(p=ggplot(result) + geom_point(aes(AvgPrice,FinalPnL, color=AvgGrowthRate)) + ggtitle("avg price - final pnl"))
    ggplotly(p=ggplot(result) + geom_point(aes(AvgGrowthRate,FinalPnL))+ggtitle("avg growth rate - final pnl"))
    ggplotly(p=ggplot(result) + geom_point(aes(StartPrice,FinalPnL))+ggtitle("start price - final pnl"))
    ggplotly(p=ggplot(result) + geom_point(aes(EndPrice,FinalPnL))+ggtitle("end price - final pnl"))
    p1 <- ggplot(result) + geom_point(aes(AvgPrice, OptionPnL)) + ggtitle("avg price - option pnl")
    p2<-ggplot(result) + geom_point(aes(AvgPrice, HedgingPnL)) + ggtitle("avg price - hedging pnl")
    grid.arrange(p1,p2,nrow = 1)

    a1 <- ggplot(result) + geom_point(aes(AvgGrowthRate,OptionPnL))+ggtitle("avg growth rate - option pnl")
    a2 <- ggplot(result) + geom_point(aes(AvgGrowthRate,HedgingPnL))+ggtitle("avg growth rate - hedging pnl")
    grid.arrange(a1,a2, nrow = 1)

    a3 <- ggplot(result) + geom_point(aes(x = StartPrice, y = EndPrice, color = OptionPnL), alpha = 0.7)+ggtitle("start & end price - option pnl")
     a4 <-ggplot(result) + geom_point(aes(x = StartPrice, y = EndPrice, color = HedgingPnL), alpha = 0.7)+ggtitle("start & end price - hedging pnl")
     grid.arrange(a3,a4, nrow=1)

As can be seen from the graphs, we get extreme and volatile final PnL when average prices are about 230 and 260, where the density function of stock prices also peaked around the same level. As we explore further, these extreme pnl points occur only when start price is close to 220 and end price is close to 237.5, or start price is close to 250 and end price is close to 268. Comparing the the hedging and option PnL, we clearly see a hedging relationship between option and stock position in this strategy.There also seems to exist a linear relationship between final p&L and average growth rate of stock, which is consistent with our expectation.

Sharpe ratio doesn’t have significant correlation with average growth rate, which means hedging is successful and the portfolio has little exposure to stock’s risk. What’s more, comparing sharpe ratio with final pnl, we find that the volatility changes dramatically during this period.

     kable(head(result,20))
StartDate OptionPnL HedgingPnL FinalPnL MaxDrawdown SharpeRatio StartPrice EndPrice AvgPrice AvgGrowthRate
2017-12-13 463.0454 274.320982 737.3664 737.3664 0.9493985 255.56 257.03 256.1119 -0.0309524
2017-12-14 441.4060 282.174011 723.5800 723.5800 0.9269234 255.48 257.03 256.1395 0.0735000
2017-12-15 592.4204 137.400554 729.8209 729.8209 0.9267920 257.17 257.03 256.1742 0.0815789
2017-12-18 629.6078 -106.304115 523.3037 612.8769 0.4546652 260.02 253.65 256.1125 -0.1760000
2017-12-19 644.4881 150.356901 794.8450 814.2243 0.5814012 256.48 250.97 255.6600 -0.4525000
2017-12-20 555.9713 195.319395 751.2907 799.1877 0.6219727 255.18 256.12 255.6420 -0.0180000
2017-12-21 659.1798 -99.105810 560.0740 560.0740 0.6963359 261.01 256.12 255.6663 0.0494737
2017-12-22 645.1820 -6.906743 638.2753 638.2753 0.6348695 258.97 256.12 255.3694 -0.2716667
2017-12-26 -477.5047 1331.881318 854.3766 854.3766 0.6817980 257.72 269.03 256.8571 0.4790476
2017-12-27 -578.7691 1355.833608 777.0645 777.0645 0.7059542 255.95 268.14 257.3533 0.4961905
2017-12-28 -533.5051 1312.583360 779.0783 779.0783 0.6836808 256.50 268.14 257.4235 0.6095000
2017-12-29 -700.4934 1428.489321 727.9960 727.9960 0.6746518 254.76 268.14 257.4721 0.6126316
2018-01-02 -1025.2362 1645.024625 619.7884 619.7884 0.7411971 255.67 272.23 259.9432 0.7940909
2018-01-03 -61.6881 604.199905 542.5118 542.5118 0.7076584 253.29 260.04 260.1418 0.1986364
2018-01-04 313.1923 279.994106 593.1864 593.1864 0.6969084 256.83 260.04 260.4681 0.3214286
2018-01-05 176.1221 382.913602 559.0357 559.0357 0.6575560 255.52 260.04 260.6500 0.1605000
2018-01-08 100.8751 1247.001760 1347.8769 1347.8769 0.3633718 251.81 257.10 260.1086 0.0718182
2018-01-09 652.6178 237.556445 890.1742 1480.1714 0.1601558 253.94 246.35 259.8605 -0.2481818
2018-01-10 650.7132 1096.522085 1747.2352 1747.2352 0.4716262 254.33 249.30 259.6495 -0.2109091
2018-01-11 667.2664 1051.752295 1719.0187 1719.0187 0.4826516 255.13 249.30 259.9029 -0.2395238